{*******************************************************************************
* The contents of this file are used with permission, subject to the Mozilla   *
* Public License Version 1.1 (the "License"); you may not use this file except *
* in compliance with the License. You may obtain a copy of the License at      *
* http://www.mozilla.org/MPL/                                                  *
*                                                                              *
* Software distributed under the License is distributed on an "AS IS" basis,   *
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *
* the specific language governing rights and limitations under the License.    *
*                                                                              *
* The Original Code is distributed as part of the "mediate" product and is     *
* Copyright (C) @home media limited. All Rights Reserved.                      *
*                                                                              *
* Email: support@athomemedia.co.uk                                             *
* Web:   http://www.athomemedia.co.uk                                          *
*******************************************************************************}

unit Shapes;

interface

uses Classes, UIObjects, Colours, XMLHelper;

const
  DEFAULT_CIRCLE_NAME = 'circle';

{$IFDEF DESIGNER}
  // Property categories and hints for designer
  CAT_SHAPE = 'Shape';
  HINT_TYPE = 'determines the type of shape';
  HINT_RADIUS = 'specifies the corner radius for round rectangle shapes';
  HINT_START = 'specifies the start angle in degrees for arcs';
  HINT_SWEEP = 'specifies the sweep angle in degrees for arcs';
  HINT_PENWIDTH = 'specifies the width of the shape outline';
  HINT_PENCOLOUR = 'specifies the name of a colour item to use for outlining the shape';
  HINT_BRUSHCOLOUR = 'specifies the name of a colour item to use for filling the shape';
  HINT_WIDTH = 'specifies width for the shape';
  HINT_HEIGHT = 'specifies height for the shape';
{$ENDIF}

type
  TAHMGeometryType = (gtUnknown, gtRoundRect, gtRectangle, gtEllipse, gtLine, gtArc);

  TAHMShape = class(TAHMUIDisplayObject)
  private
    FType: TAHMGeometryType;
    FGeometryDetail: Single;
    FVirtGeometryDetail: Integer;
    FStartAngle, FSweepAngle: Integer;
    FPenColour: TAHMColour;
    FPenWidth: Single;
    FVirtPenWidth: Integer;
    FBrushColour: TAHMColour;
  protected
    procedure SetVirtualGeometryDetail(Detail: Integer);
    procedure SetVirtualPenWidth(Width: Integer);
    procedure ClearProperties; override;
  public
    constructor Create(const Name: String); override;
    property GeometryDetail: Single read FGeometryDetail write FGeometryDetail;
    property PenWidth: Single read FPenWidth write FPenWidth;
    procedure Render(Control: TObject; iX, iY, iWidth, iHeight: Single); override;
    procedure Render(Control: TObject; iX, iY, iWidth, iHeight: Single; Clip: Boolean); override;
    procedure SeedObject; override;
    procedure Assign(Source: TPersistent); override;
    procedure SaveXMLBody(Lines: TStrings); override;
    procedure ParseFromXML(XML: TAHMXMLHelper); override;
    procedure InvalidateUIObject(UIObject: TAHMUIObject); override;
    procedure BuildProperties(Properties: TAHMUIPropertyList); override;
  published
    property Geometry: TAHMGeometryType read FType write FType;
    property VirtualGeometryDetail: Integer read FVirtGeometryDetail write SetVirtualGeometryDetail;
    property StartAngle: Integer read FStartAngle write FStartAngle;
    property SweepAngle: Integer read FSweepAngle write FSweepAngle;
    property VirtualPenWidth: Integer read FVirtPenWidth write SetVirtualPenWidth;
    property PenColour: TAHMColour read FPenColour write FPenColour;
    property BrushColour: TAHMColour read FBrushColour write FBrushColour;
    // Publish inherited properties
    property VirtualWidth;
    property VirtualHeight;
  end;

  TAHMShapeList = class(TAHMUIObjectList)
  private
  protected
  public
    constructor Create; override;
    function AddShape(const InheritFrom, NewName: String): TAHMShape;
    function GetShape(const Name: String): TAHMShape;
    procedure PopulateDefaultObjects; override;
    procedure CleardownDefaultObjects; override;
  end;


implementation

uses SysUtils, ApplicationManager, TagNames, XMLTags, ErrorCodes, BaseControls,
     ColourRenderer, Screen, Logging, Canvas, Colour, AHMTypes;

constructor TAHMShapeList.Create;
begin
  inherited Create;

  XMLTagName := TAG_SHAPES;
  ChildClass := TAHMShape;
end;

function TAHMShapeList.AddShape(const InheritFrom, NewName: String): TAHMShape;
begin
  Result := TAHMShape(Inherit(InheritFrom, NewName));
end;

function TAHMShapeList.GetShape(const Name: String): TAHMShape;
begin
  Result := TAHMShape(GetObject(Name));
end;

procedure TAHMShapeList.PopulateDefaultObjects;
begin
  with ApplicationManagerInstance.ThemeManager.VisualDescriptor do
  begin
    with DefaultObject as TAHMShape do
    begin
      Geometry := gtEllipse;
      VirtualWidth := DEFAULT_CTRL_WIDTH;
      VirtualHeight := DEFAULT_CTRL_HEIGHT;
      VirtualPenWidth := 5;
      BrushColour := TAHMColour.Create('Dark Red');
      BrushColour.ColourDef := 'd0800000';
      PenColour := TAHMColour(ColourList.DefaultObject);
    end;

    with DefaultObjects[STATE_VAL_IDLE] as TAHMShape do
    begin
      Geometry := gtRoundRect;
      VirtualWidth := DEFAULT_CTRL_WIDTH;
      VirtualHeight := DEFAULT_CTRL_HEIGHT;
      VirtualGeometryDetail := 15;
      VirtualPenWidth := 5;
      BrushColour := TAHMColour.Create('Dark Grey');
      BrushColour.ColourDef := 'd0808080';
      PenColour := TAHMColour(ColourList.DefaultObject);
    end;

    with DefaultObjects[STATE_VAL_FOCUS] as TAHMShape do
    begin
      Geometry := gtRoundRect;
      VirtualWidth := DEFAULT_CTRL_WIDTH;
      VirtualHeight := DEFAULT_CTRL_HEIGHT;
      VirtualGeometryDetail := 15;
      VirtualPenWidth := 5;
      BrushColour := TAHMColour.Create('Dark Grey');
      BrushColour.ColourDef := 'd0a0a0a0';
      PenColour := TAHMColour(ColourList.DefaultObject);
    end;

    with DefaultObjects[STATE_VAL_PRESS] as TAHMShape do
    begin
      Geometry := gtRoundRect;
      VirtualWidth := DEFAULT_CTRL_WIDTH;
      VirtualHeight := DEFAULT_CTRL_HEIGHT;
      VirtualGeometryDetail := 15;
      VirtualPenWidth := 3;
      BrushColour := TAHMColour.Create('Dark Grey');
      BrushColour.ColourDef := 'd0606060';
      PenColour := TAHMColour(ColourList.DefaultObject);
    end;

    with DefaultObjects[STATE_VAL_DISABLE] as TAHMShape do
    begin
      Geometry := gtRoundRect;
      VirtualWidth := DEFAULT_CTRL_WIDTH;
      VirtualHeight := DEFAULT_CTRL_HEIGHT;
      VirtualGeometryDetail := 15;
      VirtualPenWidth := 5;
      BrushColour := TAHMColour.Create('Dark Grey');
      BrushColour.ColourDef := 'd0404040';
      PenColour := TAHMColour(ColourList.DefaultObject);
    end;

    with DefaultObjects[STATE_VAL_IDLE_CHECK] as TAHMShape do
    begin
      Geometry := gtEllipse;
      VirtualWidth := DEFAULT_CTRL_HEIGHT div 5;
      VirtualHeight := DEFAULT_CTRL_HEIGHT div 5;
      VirtualPenWidth := 2;
      BrushColour := TAHMColour.Create('Black');
      BrushColour.ColourDef := 'd0000000';
      PenColour := TAHMColour(ColourList.DefaultObject);
    end;

    with DefaultObjects[TAG_BACKGROUND] as TAHMShape do
    begin
      Geometry := gtEllipse;
      VirtualWidth := DEFAULT_CTRL_HEIGHT;
      VirtualHeight := DEFAULT_CTRL_HEIGHT;
      VirtualPenWidth := 5;
      BrushColour := TAHMColour.Create('Dark Grey');
      BrushColour.ColourDef := 'd0808080';
      PenColour := TAHMColour(ColourList.DefaultObject);
    end;

    with DefaultObjects[TAG_DIAL] as TAHMShape do
    begin
      Geometry := gtEllipse;
      VirtualWidth := DEFAULT_CTRL_HEIGHT div 2;
      VirtualHeight := DEFAULT_CTRL_HEIGHT div 2;
      VirtualPenWidth := 2;
      BrushColour := TAHMColour.Create('Black');
      BrushColour.ColourDef := 'd0000000';
      PenColour := TAHMColour(ColourList.DefaultObject);
    end;

    with DefaultObjects[TAG_BAR] as TAHMShape do
    begin
      Geometry := gtRoundRect;
      VirtualWidth := DEFAULT_CTRL_WIDTH div 10;
      VirtualHeight := DEFAULT_CTRL_HEIGHT div 5;
      VirtualGeometryDetail := 15;
      VirtualPenWidth := 2;
      BrushColour := TAHMColour.Create('Black');
      BrushColour.ColourDef := 'd0000000';
      PenColour := TAHMColour(ColourList.DefaultObject);
    end;
  end;
end;

procedure TAHMShapeList.CleardownDefaultObjects;
begin
  with DefaultObject as TAHMShape do BrushColour.Free;
  with DefaultObjects[STATE_VAL_IDLE] as TAHMShape do BrushColour.Free;
  with DefaultObjects[STATE_VAL_FOCUS] as TAHMShape do BrushColour.Free;
  with DefaultObjects[STATE_VAL_PRESS] as TAHMShape do BrushColour.Free;
  with DefaultObjects[STATE_VAL_DISABLE] as TAHMShape do BrushColour.Free;
  with DefaultObjects[STATE_VAL_IDLE_CHECK] as TAHMShape do BrushColour.Free;
  with DefaultObjects[TAG_BACKGROUND] as TAHMShape do BrushColour.Free;
  with DefaultObjects[TAG_DIAL] as TAHMShape do BrushColour.Free;
  with DefaultObjects[TAG_BAR] as TAHMShape do BrushColour.Free;
end;

//----------------------------------------------------------------------------//
constructor TAHMShape.Create(const Name: String);
begin
  inherited Create(Name);

  XMLTagName := TAG_SHAPE;
  ObjectType := otShapes;
  ImageIndex := Ord(otShapes);
end;

procedure TAHMShape.SetVirtualGeometryDetail(Detail: Integer);
begin
  FVirtGeometryDetail := Detail;
  FGeometryDetail := ScreenInstance.ScaleVirtualX(Detail);
end;

procedure TAHMShape.SetVirtualPenWidth(Width: Integer);
begin
  FVirtPenWidth := Width;
  FPenWidth := ScreenInstance.ScaleVirtualX(Width);
end;

procedure TAHMShape.ClearProperties;
begin
  inherited;

  // Clear custom shape properties
  FType := gtUnknown;
  FPenColour := nil;
  FBrushColour := nil;
  FStartAngle := 0;
  FSweepAngle := 0;
  VirtualPenWidth := 0;
  VirtualGeometryDetail := 0;
end;

procedure TAHMShape.Render(Control: TObject; iX, iY, iWidth, iHeight: Single);
begin
  // Delegate to method below without clipping
  Render(Control, iX, iY, iWidth, iHeight, False);
end;

procedure TAHMShape.Render(Control: TObject; iX, iY, iWidth, iHeight: Single; Clip: Boolean);
var
  oControl: TAHMAbstractControl;
  DestRect: TAHMRectF;
  XRadius, YRadius: Single;
begin
  // Pre-render our control if necessary
  inherited;

  // Get details of passed control & its viewport
  oControl := Control as TAHMAbstractControl;

  // Use the cache to render our shape onto control viewport
  with oControl.Viewport, oControl do
  begin
    Canvas.PenWidth := FPenWidth;
    if FPenColour <> nil then Canvas.PenColour := FPenColour.Colour
                         else Canvas.PenColour := nil;
    if FBrushColour <> nil then Canvas.BrushColour := FBrushColour.Colour
                           else Canvas.BrushColour := nil;

    // Use control dimensions if set, otherwise graphic size
    if (iWidth <> 0) and (iHeight <> 0) then
      DestRect := CanvasRect(iX, iY, iWidth, iHeight)
    else
      DestRect := CanvasRect(iX, iY, Self.Width, Self.Height);

    // Draw appropriate shape type inside viewport canvas
    case FType of
      gtRectangle:
      begin
        Canvas.FillRect(DestRect, nil, Gamma, XScale, YScale);
        Canvas.Rectangle(DestRect, Gamma, XScale, YScale);
      end;
      gtRoundRect:
      begin
        Canvas.FillRoundRect(DestRect, Gamma, FGeometryDetail, XScale, YScale);
        Canvas.RoundRect(DestRect, Gamma, FGeometryDetail, XScale, YScale);
      end;
      gtEllipse:
      begin
        XRadius := DestRect.Width * XScale;
        YRadius := DestRect.Height * YScale;
        iX := DestRect.X + (DestRect.Width / 2);
        iY := DestRect.Y + (DestRect.Height / 2);
        Canvas.FillEllipse(iX, iY, XRadius, YRadius, Gamma);
        Canvas.DrawEllipse(iX, iY, XRadius, YRadius, Gamma);
      end;
      gtLine:
        Canvas.Line(ScaleRect(DestRect, XScale, YScale), Gamma);
      gtArc:
      begin
        XRadius := DestRect.Width * XScale;
        YRadius := DestRect.Height * YScale;
        iX := DestRect.X + (DestRect.Width / 2);
        iY := DestRect.Y + (DestRect.Height / 2);
        Canvas.DrawArc(iX, iY, XRadius, YRadius, FStartAngle, FSweepAngle, Gamma);
      end;
    end;
  end;
end;

procedure TAHMShape.SeedObject;
begin
{$IFDEF DESIGNER}
  if Ancestor = nil then
    with ApplicationManagerInstance.ThemeManager.VisualDescriptor do
    begin
      Geometry := gtRoundRect;
      VirtualWidth := DEFAULT_CTRL_WIDTH;
      VirtualHeight := DEFAULT_CTRL_HEIGHT;
      VirtualGeometryDetail := 15;
      VirtualPenWidth := 3;
      BrushColour := ColourList.GetColour(DEFAULT_OBJECT_NAME);
      PenColour := ColourList.GetColour(DEFAULT_WHITE_NAME);
    end;
{$ENDIF}
end;

procedure TAHMShape.Assign(Source: TPersistent);
begin
  inherited Assign(Source);

  with Source as TAHMShape do
  begin
    Self.Geometry := Geometry;
    Self.VirtualGeometryDetail := VirtualGeometryDetail;
    Self.StartAngle := StartAngle;
    Self.SweepAngle := SweepAngle;
    Self.VirtualPenWidth := VirtualPenWidth;
    Self.PenColour := PenColour;
    Self.BrushColour := BrushColour;
  end;
end;

procedure TAHMShape.SaveXMLBody(Lines: TStrings);
var
  oAncs: TAHMShape;
  sWork: String;
begin
  // Determine which ancestor to compare against - real or empty
  oAncs := TAHMShape(ObjectToCompare);

  // Only populate attributes that differ from our ancestor
  if ((FType <> gtUnknown) and (FType <> oAncs.Geometry)) or
     ((FGeometryDetail <> 0) and (FGeometryDetail <> oAncs.GeometryDetail)) then
  begin
    sWork := TGB+TAG_GEOMETRY+SPC+ATTR_TYPE+ATB;
    if FType = gtRoundRect then sWork := sWork + ATTR_VAL_ROUND_RECT
    else if FType = gtRectangle then sWork := sWork + ATTR_VAL_RECT
    else if FType = gtLine then sWork := sWork + ATTR_VAL_LINE
    else if FType = gtArc then sWork := sWork + ATTR_VAL_ARC
    else sWork := sWork + ATTR_VAL_ELLIPSE;

    // Do we need to store geometry detail too?
    if (FType = gtRoundRect) and (FVirtGeometryDetail <> 0) and
       (FVirtGeometryDetail <> oAncs.VirtualGeometryDetail) then
      sWork := sWork + ATN+ATTR_RADIUS+ATB + IntToStr(FVirtGeometryDetail);
    if (FType = gtArc) and (FStartAngle <> 0) and
       (FStartAngle <> oAncs.StartAngle) then
      sWork := sWork + ATN+ATTR_ANGLE+ATB + IntToStr(FStartAngle);
    if (FType = gtArc) and (FSweepAngle <> 0) and
       (FSweepAngle <> oAncs.SweepAngle) then
      sWork := sWork + ATN+ATTR_SWEEP+ATB + IntToStr(FSweepAngle);

    Lines.Add(TABS[3] + sWork + ATE);
  end;

  // Do we need to store pen details?
  if ((FVirtPenWidth <> 0) and (FVirtPenWidth <> oAncs.VirtualPenWidth)) or
     ((FPenColour <> nil) and (FPenColour <> oAncs.PenColour)) then
  begin
    Lines.Add(TABS[3] + TGB+TAG_PEN+TGC);
    if (FVirtPenWidth <> 0) and (FVirtPenWidth <> oAncs.VirtualPenWidth) then
      Lines.Add(TABS[4] + TGB+TAG_WIDTH+TGC + IntToStr(FVirtPenWidth) + TGE+TAG_WIDTH+TGC);
    if (FPenColour <> nil) and (FPenColour <> oAncs.PenColour) then
      Lines.Add(TABS[4] + FPenColour.XMLReference);
    Lines.Add(TABS[3] + TGE+TAG_PEN+TGC);
  end;

  // Do we need to store brush details?
  if (FBrushColour <> nil) and (FBrushColour <> oAncs.BrushColour) then
  begin
    Lines.Add(TABS[3] + TGB+TAG_BRUSH+TGC);
    Lines.Add(TABS[4] + FBrushColour.XMLReference);
    Lines.Add(TABS[3] + TGE+TAG_BRUSH+TGC);
  end;

  // Do we need to store size?
  if ((VirtualWidth <> 0) and (VirtualWidth <> oAncs.VirtualWidth)) or
     ((VirtualHeight <> 0) and (VirtualHeight <> oAncs.VirtualHeight)) then
    Lines.Add(TABS[3] + TGB+TAG_SIZE+TGC+ IntToStr(VirtualWidth) + ',' +
              IntToStr(VirtualHeight) + TGE+TAG_SIZE+TGC);
end;

procedure TAHMShape.ParseFromXML(XML: TAHMXMLHelper);
var
  sType, sRadius, sStart, sSweep, sWidth, sColour: String;
  iW, iH: Integer;
  ShapeNode, PropsNode, DetailNode: TAHMXMLNode;
begin
  // Initialise parsing nodes
  ShapeNode := XML.CurrentNode;
  PropsNode := nil;

  // All shape elements are optional, so see what we have
  while XML.NextElement(ShapeNode, PropsNode) do
    with ApplicationManagerInstance.ThemeManager.VisualDescriptor do
    begin
      if XML.CurrentElement = TAG_GEOMETRY then
      begin
        // Determine the shape geometry and any optional attributes
        sType := XML.GetAttribute(ATTR_TYPE);
        if      sType = ATTR_VAL_RECT       then Geometry := gtRectangle
        else if sType = ATTR_VAL_LINE       then Geometry := gtLine
        else if sType = ATTR_VAL_ELLIPSE    then Geometry := gtEllipse
        else if sType = ATTR_VAL_ARC        then Geometry := gtArc
        else if sType = ATTR_VAL_ROUND_RECT then Geometry := gtRoundRect;

        // Rounded rectangle has additional corner radius attribute
        if Geometry in [gtRoundRect] then
        begin
          sRadius := XML.GetAttribute(ATTR_RADIUS);
          if sRadius <> '' then VirtualGeometryDetail := StrToInt(sRadius);
        end;

        // Arc has additional start and sweep angle attributes
        if Geometry = gtArc then
        begin
          sStart := XML.GetAttribute(ATTR_ANGLE);
          sSweep := XML.GetAttribute(ATTR_SWEEP);
          if sStart <> '' then StartAngle := StrToIntDef(sStart, 0);
          if sSweep <> '' then SweepAngle := StrToIntDef(sSweep, 0);
        end;
      end
      else if XML.CurrentElement = TAG_PEN then
      begin
        DetailNode := nil;

        // Get details of pen
        while XML.NextElement(PropsNode, DetailNode) do
        begin
          if XML.CurrentElement = TAG_WIDTH then
          begin
            sWidth := XML.GetValue;

            // Default pen width to 1 if not specified, and no ancestor
            if sWidth <> '' then VirtualPenWidth := StrToInt(sWidth)
            else if Ancestor = nil then VirtualPenWidth := 1;
          end
          else if XML.CurrentElement = TAG_COLOUR then
          begin
            sColour := XML.GetAttribute(ATTR_NAME);
            if sColour <> '' then PenColour := ColourList.GetColour(sColour);
          end;
        end;
      end
      else if XML.CurrentElement = TAG_BRUSH then
      begin
        // Get details of brush
        if not XML.ReadElementAttribute(TAG_COLOUR, ATTR_NAME, sColour) then
          LogParsingError(THM_PRS_VIS_MALFORMED_BRUSH_TAGS, Self);

        if sColour <> '' then BrushColour := ColourList.GetColour(sColour);
      end
      else if XML.CurrentElement = TAG_SIZE then
      begin
        if not XML.GetCoordsValue(iW, iH) then
          LogParsingError(THM_PRS_VIS_MALFORMED_SIZE_TAGS, Self);

        if iW <> 0 then VirtualWidth := iW;
        if iH <> 0 then VirtualHeight := iH;
      end;
    end;
end;

procedure TAHMShape.InvalidateUIObject(UIObject: TAHMUIObject);
begin
  // Changes to pen or brush colour will invalidate the shape
  if (UIObject = FPenColour) or (UIObject = FBrushColour) then
    ApplicationManagerInstance.UIManager.InvalidateUIObject(Self);
end;

procedure TAHMShape.BuildProperties(Properties: TAHMUIPropertyList);
begin
{$IFDEF DESIGNER}
  inherited;

  // Build custom shape properties
  Properties.Add('Geometry', 'Geometry', CAT_SHAPE, HINT_TYPE);
  Properties.Add('Corner Radius', 'VirtualGeometryDetail', CAT_SHAPE, HINT_RADIUS);
  Properties.Add('Start Angle', 'StartAngle', CAT_SHAPE, HINT_START);
  Properties.Add('Sweep Angle', 'SweepAngle', CAT_SHAPE, HINT_SWEEP);
  Properties.Add('Pen Width', 'VirtualPenWidth', CAT_SHAPE, HINT_PENWIDTH);
  Properties.Add('Pen Colour', 'PenColour', CAT_SHAPE, HINT_PENCOLOUR);
  Properties.Add('Brush Colour', 'BrushColour', CAT_SHAPE, HINT_BRUSHCOLOUR);
  Properties.Add('Width', 'VirtualWidth', CAT_SHAPE, HINT_WIDTH);
  Properties.Add('Height', 'VirtualHeight', CAT_SHAPE, HINT_HEIGHT);
{$ENDIF}
end;


end.
